home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / printer / prtfile.arc / PRTF.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-12  |  11KB  |  301 lines
  1. program prtf ;
  2.   { Prints a text file on the list device, formatted with various
  3.     user-supplied options.  Turbo Pascal, MS/PC-DOS.  Public Domain.
  4.  
  5.     Bill Meacham
  6.     1004 Elm Street, Austin, Tx  78703
  7.  
  8.     This revision picks up the DOS date and time and puts it into the
  9.     header.  Does NOT ask for header and pages to print -- prints all
  10.     with no header.  Single space only.
  11.  
  12.     You can specify up to maxparms (see const below) file names on the
  13.     command line and it will print them all.  If you don't specify any
  14.     on the command line, it will ask for one.
  15.  
  16.     To quit, enter a blank file name when it asks you for one.
  17.     To quit prematurely, type any letter.  It will ask if you want to quit.
  18.  
  19.     Last modified: 11/12/87 }
  20.  
  21. {$V-}  { Turn off strict type-checking for strings }
  22.  
  23. label            99 ;               { for premature exit }
  24.  
  25. const
  26.     formfeed   = ^L ;
  27.     bell       = ^G ;
  28.     linelength = 255 ;              { max length of text file lines }
  29.     maxparms   = 10 ;               { max number of files on command line }
  30.  
  31. type
  32.     st_typ  = string[linelength] ;
  33.     regpack = record case integer of
  34.                 1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags : integer) ;
  35.                 2: (AL,AH,BL,BH,CL,CH,DL,DH : byte)
  36.                end ;
  37.     str14   = string[14] ;
  38.     str66   = string[66] ;
  39.     parmarray = array[1..maxparms] of str66 ;
  40.  
  41. var
  42.     registers                  : regpack ;
  43.     parms                      : parmarray ;   { command line parameters }
  44.     line, header               : st_typ ;      { print lines }
  45.     blank_line                 : st_typ ;      { to add indentation }
  46.     page_num, line_cnt,
  47.     p_count, i, n, p           : integer ;     { counters }
  48.     indent, spacing, max_lines : integer ;     { user-supplied }
  49.     first_page, last_page      : integer ;     { user_supplied }
  50.     fname                      : string[66] ;  { file name }
  51.     ipt_file                   : text ;        { input file }
  52.     ok                         : boolean ;     { whether file exists }
  53.     reply                      : char ;        { to get user response }
  54.     quit                       : boolean ;     { to flag when last page printed }
  55.  
  56. { ----------------------------------------------------------------- }
  57.  
  58. function date_and_time : str14 ;
  59.   { get DOS system date and time }
  60.  
  61. var
  62.   year,
  63.   month,day,
  64.   hour,min  : string[2];
  65.  
  66. begin
  67.   with registers do
  68.     begin
  69.       AX := $2A00 ;
  70.       msdos(registers) ;
  71.       str(CX-1900,year) ;
  72.       str(DH,month) ;
  73.       str(DL,day) ;
  74.       AX := $2C00 ;
  75.       msdos (registers) ;
  76.       str(CH:2,hour) ;
  77.       str(CL:2,min) ;
  78.     end ;
  79.   if  min[1] = ' ' then  min[1] := '0' ;
  80.   if  (hour[1] = ' ')
  81.   and (hour[2] = '0') then
  82.       hour := '00' ;
  83.   date_and_time := concat (month,'/',day,'/',year,' ',hour,':',min) ;
  84. end ; { function getdate }
  85.  
  86. { ----------------------------------------------------------------- }
  87.  
  88. procedure print_page_header ;
  89.   { prints header line at top of each page -- revised, 11/17/84 }
  90.     var
  91.         i : integer ;
  92.     begin
  93.         page_num := page_num + 1 ;
  94.         if page_num > last_page then
  95.             quit := true
  96.         else
  97.           begin
  98.             if page_num >= first_page then
  99.               begin
  100.                 if page_num > first_page then
  101.                     write (lst, formfeed) ;
  102.                 writeln (lst) ;
  103.                 write (lst, header) ;
  104.                 writeln (lst, page_num) ;
  105.                 writeln (lst) ;
  106.                 for i := 1 to spacing do
  107.                     writeln (lst)
  108.               end ;
  109.             line_cnt := 3 + spacing
  110.           end
  111.     end ;  { proc print_page_header }
  112.  
  113. { ----------------------------------------------------------------- }
  114.  
  115. procedure print (line : st_typ ; num_newlines : integer) ;
  116.   { prints a line and the number of newlines indicated }
  117.     var
  118.         i : integer ;
  119.     begin
  120.         if line_cnt > max_lines then
  121.             print_page_header ;
  122.         if  (page_num >= first_page)
  123.         and (page_num <= last_page) then
  124.           begin
  125.             write (lst,line) ;
  126.             for i := 1 to num_newlines do
  127.                 writeln (lst)
  128.           end ;
  129.         line_cnt := line_cnt + num_newlines
  130.     end ;  { proc print }
  131.  
  132. { ----------------------------------------------------------------- }
  133.  
  134. procedure add_blanks (var st : st_typ ; num_blanks : integer) ;
  135.   { appends the number of blanks indicated to the string }
  136.     var
  137.         i : integer ;
  138.     begin
  139.         for i := 1 to num_blanks do
  140.             st := concat (st,' ')
  141.     end ;  { proc add_blanks }
  142.  
  143. { ----------------------------------------------------------------- }
  144.  
  145. function adjust_line (line : st_typ) : st_typ ;
  146.   { Converts tabs to spaces and adds indentation by moving characters
  147.     one by one from the input string to a work string.  If it encounters
  148.     a tab character it expands the tab to the proper number of spaces.
  149.     Finally, the indentation string is inserted in front of all the
  150.     characters and the function returns the work string. }
  151.     
  152.     const
  153.         tab = ^I ;
  154.     var
  155.         i            : integer ;    { loop counter }
  156.         next_char    : integer ;    { where the next character goes
  157.                                       in the work string }
  158.         work_str     : st_typ ;     { work string to build adjusted line }
  159.     begin
  160.         work_str := '' ;
  161.         next_char := 1 ;
  162.         for i := 1 to length(line) do
  163.             if not (line[i] = tab) then
  164.               begin
  165.                 work_str := concat(work_str,line[i]) ;
  166.                 next_char := next_char + 1
  167.               end
  168.             else         { character is a tab -- convert to spaces }
  169.                 repeat
  170.                     work_str := concat(work_str,' ') ;
  171.                     next_char := next_char + 1
  172.                 until (next_char > 8) and ((next_char mod 8) = 1) ;
  173.         insert (blank_line,work_str,1) ;
  174.         adjust_line := work_str
  175.     end ;  { --- proc adjust_line --- }
  176.  
  177. { ----------------------------------------------------------------- }
  178.  
  179. begin { --- MAIN --- }
  180.     writeln ;
  181.     writeln ('This prints one or more text files, paginated with DOS date & time.') ;
  182.     writeln ('Defaults are no indent, 58 lines per page.') ;
  183.     writeln ('If not on command line, specify file name last; <cr> on file name to cancel.') ;
  184.     writeln ;
  185.  
  186.     for i := 1 to maxparms do                    { get file names from }
  187.         parms[i] := '' ;                         { command line }
  188.     p_count := paramcount ;
  189.     if p_count > maxparms then p_count := maxparms ;
  190.     for i := 1 to p_count do
  191.         parms[i] := paramstr(i) ;
  192.     p := 1 ;
  193.  
  194.     indent := 0 ;                                { get indentation }
  195.     write   ('Number of spaces to indent? ') ;
  196.     readln  (indent) ;
  197.     if indent < 0 then indent := 0 ;
  198.     blank_line := '' ;
  199.     if not (indent = 0 ) then
  200.         for i := 1 to indent do
  201.             blank_line := concat (' ',blank_line) ;
  202.  
  203.     spacing    := 1 ;                            { line spacing }
  204.     first_page := 1 ;
  205.     last_page  := maxint ;
  206.  
  207.     max_lines := 0 ;                             { get page length }
  208.     write   ('Max lines per page? ') ;
  209.     readln  (max_lines) ;
  210.     if max_lines < 1 then
  211.         max_lines := 58 ;
  212.  
  213.     while true do                                { endless loop }
  214.       begin
  215.         if p_count = 0 then
  216.             fname := ''
  217.         else if (p > p_count) then
  218.           begin
  219.             writeln ('Done!',bell) ;
  220.             halt                                 { --- Exit loop here --- }
  221.           end
  222.         else { p <= p_count }                    { get file name }
  223.           begin
  224.             fname := parms[p] ;
  225.             p := succ(p)
  226.           end ;
  227.         repeat
  228.             if fname = '' then
  229.               begin
  230.                 write   ('File name? ') ;
  231.                 readln  (fname) ;
  232.               end ;
  233.             if fname = '' then
  234.                 halt                             { --- Exit loop here --- }
  235.             else
  236.               begin
  237.                 for n := 1 to length(fname) do
  238.                     fname[n] := upcase(fname[n]) ;
  239.                 assign (ipt_file,fname) ;
  240.                 {$i-}
  241.                 reset (ipt_file) ;
  242.                 {$i+}
  243.                 ok := (ioresult = 0) ;
  244.                 if not ok then
  245.                   begin
  246.                     writeln (bell,'File ',fname,' not found.') ;
  247.                     fname := ''
  248.                   end
  249.               end
  250.         until ok ;
  251.  
  252.         header := blank_line ;                   { build header line }
  253.         header := concat(header,fname) ;
  254.         if length(header) < 57 then
  255.             add_blanks (header, 57 - length(header))
  256.         else
  257.             add_blanks (header,2) ;
  258.         header := concat (header,date_and_time,' Page ') ;
  259.         page_num := 0 ;
  260.         line_cnt := maxint ;                     { force first page header }
  261.  
  262.         quit := false ;
  263.         writeln ('Printing ',fname) ;
  264.         while not (eof(ipt_file)) do             { print the text file }
  265.           begin
  266.             readln (ipt_file,line) ;
  267.             if not (indent = 0) then             { add identation }
  268.                 line := adjust_line (line) ;
  269.             repeat
  270.                 n := pos(formfeed,line) ;        { handle embedded formfeeds }
  271.                 if not (n = 0) then
  272.                   begin
  273.                     print (copy(line,1,n-1),spacing) ;
  274.                     print_page_header ;
  275.                     if quit then
  276.                         goto 99 ;
  277.                     delete (line,1,n) ;
  278.                     for i := 1 to indent do
  279.                         line := concat(' ',line) ;
  280.                   end
  281.             until n = 0 ;
  282.             print  (line,spacing) ;
  283.  
  284.             if keypressed then                   { check for premature exit }
  285.               begin
  286.                 writeln ;
  287.                 write  ('+++ Quit now? (Y/N): ') ;
  288.                 readln (reply) ;
  289.                 if upcase(reply) = 'Y' then
  290.                     goto 99
  291.               end ;
  292.             if quit then
  293.                 goto 99
  294.           end ; { while not EOF }
  295.  
  296. 99:     write (lst,formfeed) ;
  297.         if p_count = 0 then
  298.             writeln ('Done!',bell)
  299.       end  { while true, endless loop }
  300. end.
  301.